with Ada.Unchecked_Conversion;

with Win32.Windef;
with Win32.Winbase;

package win32api_interface.process is

  --  This package contains some Win32 routines for locating processes,
  --  obtaining object names, and so on. It simplifies the access to them
  --  from Ada. Requires the Win32 Ada Binding libraries.

  --  Constant definitions:
  Max_Path          : constant := Win32.Windef.MAX_PATH;
  MAX_MODULE_NAME32 : constant := 255;

  PSAPI_Handle : Win32.Windef.HINSTANCE := Win32.Winbase.LoadLibrary(
                                             Win32.Addr("PSAPI"&ascii.nul));
  Ntdll_Handle : Win32.Windef.HINSTANCE := Win32.Winbase.LoadLibrary(
                                             Win32.Addr("NTDLL"&ascii.nul));

  TH32CS_SNAPHEAPLIST : constant := 16#00000001#;
  TH32CS_SNAPPROCESS  : constant := 16#00000002#;
  TH32CS_SNAPTHREAD   : constant := 16#00000004#;
  TH32CS_SNAPMODULE   : constant := 16#00000008#;
  TH32CS_INHERIT      : constant := 16#80000000#;
  TH32CS_SNAPALL      : constant := 16#0000000F#;

  --  Type definitions:
  subtype Process_ID is Win32.DWORD;
  subtype DWord is Win32.DWORD;
  subtype PCWCH is Win32.PCWCH;
  subtype LPCStr is Win32.LPCSTR;
  subtype HInstance is Win32.Windef.HINSTANCE;
  subtype HModule is Win32.Windef.HMODULE;
  subtype Chara is Win32.CHAR;
  subtype ULong is Win32.ULONG;
  subtype lpVoid is Win32.LPVOID;
  subtype Long is Win32.LONG;
  subtype PBYTE is Win32.PBYTE;
  subtype TCHAR_array is Win32.Winnt.TCHAR_array;

  type System_Handle is record
     UniqueProcessId : Win32.USHORT;
     CreatorBackTraceIndex : Win32.USHORT;
     ObjectTypeIndex : Win32.UCHAR;
     HandleAttributes : Win32.UCHAR;
     HandleValue : Win32.USHORT;
     Object : Win32.PVOID;
     GrantedAccess : Win32.ULONG;
  end record;
  pragma Convention (C, System_Handle);
  type System_Handle_Array is
    array (Win32.ULONG range <>) of System_Handle;

  type MODULEENTRY32 is record
    dwSize        : Win32.DWORD;
    th32ModuleID  : Win32.DWORD;
    th32ProcessID : Win32.DWORD;
    GlblcntUsage  : Win32.DWORD;
    ProccntUsage  : Win32.DWORD;
    modBaseAddr   : Win32.PBYTE; --?
    modBaseSize   : Win32.DWORD;
    h_Module      : Win32.Windef.HMODULE;
    szModule      : Win32.Winnt.TCHAR_array(0..MAX_MODULE_NAME32 + 1);
    szExePath     : Win32.Winnt.TCHAR_array(0..MAX_PATH);
  end record;
  type PMODULEENTRY32 is access all MODULEENTRY32;

--    Kernel32_Handle : Win32.Windef.HINSTANCE := Win32.Winbase.LoadLibrary(
--                                               Win32.Addr("kernel32"&ascii.nul));

  -- Special definitions for the functions:
  --------------------------
  -- Find_All_Process_IDs --
  --------------------------

  type EnumProcesses_Access is
    access function
    (lpidProcess : System.Address;
     cb : Win32.DWORD;
     lpcbNeeded : access Win32.DWORD)
    return Win32.DWORD;
  pragma Convention (Stdcall, EnumProcesses_Access);
  function Convert is new Ada.Unchecked_Conversion
    (Win32.Windef.FARPROC, EnumProcesses_Access);
  EnumProcesses : EnumProcesses_Access
     := Convert (Win32.Winbase.GetProcAddress(
                   PSAPI_Handle,
                   Win32.Addr("EnumProcesses"&ascii.nul)));
  --  Calls the EnumProcesses function in the PSAPI library.
  --  Rturns a process ID array and its size.

  ---------------------
  -- Get_Object_Name --
  ---------------------

  type NtQueryObject_Access is access function
    (Object : Win32.Winnt.HANDLE;
     Class : Win32.DWORD;
     Information : Win32.PVOID;
     Length : Win32.ULONG;
     ReturnLength : Win32.PULONG)
    return Win32.LONG;
  pragma Convention (Stdcall, NtQueryObject_Access);
  function Convert is new Ada.Unchecked_Conversion
    (Win32.Windef.FARPROC, NtQueryObject_Access);
  NtQueryObject : NtQueryObject_Access
     := Convert (Win32.Winbase.GetProcAddress(
                   Ntdll_Handle,
                   Win32.Addr("NtQueryObject"&ascii.nul)));
  ObjectNameInformation : constant := 1;
  type Object_Name_Record is record
     Length, Maximum_Length : Win32.USHORT;
     Buffer : Win32.PWSTR;
     Object_Name : Wide_String (1 .. 2 ** 16);
  end record;
  --  ??? This record is probably *NOT* the right way to express this data
  --  structure.  But unless we know the meaning of the Length and
  --  Maximum_Length components, we can hardly do any better.

  ----------------------
  -- Get_Process_Name --
  ----------------------

  type EnumProcessModules_Access is
    access function
    (hProcess : Win32.Winnt.HANDLE;
     lphModule : access Win32.Windef.HMODULE;
     cb : Win32.DWORD;
     lpcbNeeded : access Win32.DWORD)
    return Win32.DWORD;
  pragma Convention (Stdcall, EnumProcessModules_Access);
  function Convert is new Ada.Unchecked_Conversion
    (Win32.Windef.FARPROC, EnumProcessModules_Access);
  EnumProcessModules : EnumProcessModules_Access
     := Convert (Win32.Winbase.GetProcAddress(
                   PSAPI_Handle,
                   Win32.Addr("EnumProcessModules" & ASCII.NUL)));

  ---------------------------
  --  Get_Module_Base_Name --
  ---------------------------

  type GetModuleBaseName_Access is
    access function
    (hProcess : Win32.Winnt.HANDLE;
     hModule : Win32.Windef.HINSTANCE;
     lpBaseName : Win32.Winnt.LPTSTR;
     nSize : Win32.DWORD)
    return Win32.DWORD;
  pragma Convention (Stdcall, GetModuleBaseName_Access);
  function Convert is new Ada.Unchecked_Conversion
    (Win32.Windef.FARPROC, GetModuleBaseName_Access);
  GetModuleBaseName : GetModuleBaseName_Access
     := Convert (Win32.Winbase.GetProcAddress(
                   PSAPI_Handle,
                   Win32.Addr("GetModuleBaseNameA"&ascii.nul)));

  --  Function renames (equalities):
  function PWCH_equals (Left, Right: Win32.PWCH)
    return boolean renames Win32."=";
  function Address_equals (Left, Right: System.Address)
    return boolean renames System."=";

  --  Win32 API functions:
  function lstrlenW (lpString : in Object_Name_Record) return Natural;
  --  Returns a system string length. Possibly NOT well defined.

  procedure Close_Handle (Obj : Win32.Winnt.HANDLE);
  --  Calls CloseHandle and raises an exception if necessary.

  function Create_Process(Path : in String;
                          Directory : in String) return Process_ID;
  --  Launches a program from the specified Path and returns its process ID.
  --  The envoirement directory of the launched program should be also set.

  function Open_Process(ProcID : in Process_ID) return Win32.Winnt.HANDLE;
  --  Earns access to a process given its ID and returns the access Handle.

  function Open_Process_Query(ProcID : in Process_ID) return Win32.Winnt.HANDLE;

  procedure Terminate_Process(AccessHandle : in Win32.Winnt.HANDLE);
  --  Rawly terminates a process given an acces handle. It's raw because
  --  if the process have loaded other resources such as DLLs.

  function Get_System_Handles return System_Handle_Array;
  --  Returns the system handle table. Note that this is not a direct
  --  Win32 API function, but due to how useless are the API functions
  --  in other contexts that this uses I implemented this as just one
  --  function.

  function Find_Window (Name : in String) return Win32.Winnt.HANDLE;
  --  Returns the Window Handle from the given Window name.

  function Get_Window_Thread_Process_ID (Handle : in Win32.Winnt.HANDLE)
    return Process_ID;
  --  Returns the Process ID from the process that is managing the Window
  --  that the input handle refers to.

  function Create_Toolhelp32_Snapshot
    (Proc : in Process_ID; Flag : Win32.DWORD)
     return HANDLE;

  function Module32_First (H : in Handle) return MODULEENTRY32;
  function Module32_Next (H : in Handle) return MODULEENTRY32;

  -- pragma No_Return (errorAPI.Report_Error);
  -- Raises errorAPI.Win32_Error with an appropriate error message after a failed
  -- Win32 operation.

end win32api_interface.process;
